unit upachip;

(* cpcPaChi - Un compilador de Pascal chiquitito para CPC
   Por Nacho Cabanes
   
   uPachiP - unidad "Parser" (analizador sintactico)
   
   Versiones hasta la fecha:
   
   Num.   Fecha       Cambios
   ---------------------------------------------------
   0.18  24-Ago-2008  Maneja datos "integer". Incluye
     alguna orden de graficos: plot, line, graphicsPen.
     Inc y Dec permiten un segundo parametro: cantidad
     a incrementar/decrementar.

   0.17  20-Ago-2008  Se pueden insertar funciones
     predefinididas en la tabla de s.

   0.15  15-Ago-2008  No usa ObtenerIdentificador
     sino el nuevo ObtenerToken.

   0.15  15-Ago-2008  No usa ObtenerIdentificador
     sino el nuevo ObtenerToken.

   0.14  12-Ago-2008  Permite definir procedimientos
     (sin parametros ni variables locales).
     VAR permite varias variables de igual tipo.
   
   0.13  09-Ago-2008  Permite bloques WHILE, REPEAT, FOR
     Permite DEC ademas de INC
     La 0.12 no incrementaba numeroIFactual; ahora si
     
   0.12  07-Ago-2008  Permite bloques IF..THEN..ELSE
     AnalizarCualquierOrden no obtiene la orden, por
       versatilidad.
     Anadido analizarOrdenSimpleComp
                      
   0.11  03-Ago-2008  Permite definir etiquetas (todavia solo una
     en cada declaracion LABEL) y saltar a ellas (GOTO).

   0.09  13-Jun-2008  Permite definir variables (todavia solo una
     en cada declaracion VAR)
   
   0.07  06-Abr-2008  Permite definir constantes
   
   0.06  03-Abr-2008  Incluye las ordenes PEN, PAPER, CPCMODE
                      
   0.05  29-Mar-2008  Primera version del analizador sintactico,
                      extraido del programa principal.
*)


interface

  procedure analizarPrograma;


implementation

uses
  upachid,  (* Estructuras de datos *)
  upachil,  (* Analizador lexico *)
  upachig;  (* Generador de codigo *)



procedure analizarCualquierOrden(orden: string); forward;

procedure analizarLABELoASIGN(variable: string); forward;
procedure analizarCLS; forward;
procedure analizarCONST; forward;
procedure analizarCPCINK; forward;
procedure analizarCPCMODE; forward;
procedure analizarDEC; forward;
procedure analizarFOR; forward;
procedure analizarGOTO; forward;
procedure analizarGRAPHICSPEN; forward;
procedure analizarIF; forward;
procedure analizarINC; forward;
procedure analizarLABEL; forward;
procedure analizarLINE; forward;
procedure analizarLOCATE; forward;
procedure analizarPAPER; forward;
procedure analizarPEN; forward;
procedure analizarPLOT; forward;
procedure analizarPROCEDURE; forward;
procedure analizarREPEAT; forward;
procedure analizarVAR; forward;
procedure analizarWHILE; forward;
procedure analizarWRITECHAR; forward;
procedure analizarWRITESTRING; forward;


var
  orden: string;
  cadenaTemp: string;
  x, y: integer;
  letra: char;
  codError: integer;

const
  numeroIFactual: integer = 1;
  depurando = false;


(* Estructura de un programa:
   program <identificador>;
   begin
     <ordenes>
   end.
*)
procedure analizarPrograma;
var
  orden: string;
begin
  (* program <identificador>; *)
  orden := obtenerToken.valor;
  if orden <> 'PROGRAM' then
    errorFatal('No se ha encontrado PROGRAM');
  obtenerToken;
  leerSimbolo(';');

  (* const, label o var, antes de begin *)
  repeat
  
    orden := obtenerToken.valor;

    if orden = 'CONST' then
      begin
      analizarCONST;
      end;
    
    if orden = 'VAR' then
      begin
      analizarVAR;
      end;
      
    if orden = 'LABEL' then
      begin
      analizarLABEL;
      end;
      
    if orden = 'PROCEDURE' then
      begin
      analizarPROCEDURE;
      end;
    
  until orden = 'BEGIN';
  genComentario('-- Cuerpo del programa');  
  genLABEL('INICIOPROGRAMA');

  (* Resto de ordenes *)
  while not finFicheroEntrada do
    begin
    orden := obtenerToken.valor;
    analizarCualquierOrden(orden);
    end;
end;


(* Analiza una orden simple 
   o compuesta -bloque BEGIN...END-
*)
procedure analizarOrdenSimpleComp;
var
  orden: string;
begin
  orden := obtenerToken.valor;
  (* Si no es BEGIN, es sentencia simple *)
  if orden <> 'BEGIN' then
    begin
    analizarCualquierOrden(orden);
    exit;
    end
  else
    begin
    if depurando then
      writeln('Bloque Begin-End');
    repeat
      (* Si habia BEGIN, debe terminar con END *)
      orden := obtenerToken.valor;
      if orden <> 'END' then
        analizarCualquierOrden(orden);     
    until orden = 'END';
    leerSimbolo(';');
    if depurando then
      writeln('Fin de bloque Begin-End');
    end;
end;

(* Espera cualquiera de las ordenes reconocidas y genera código
   para ella
   Por ahora permite: CLS, LOCATE, WRITECHAR
*)
procedure analizarCualquierOrden(orden: string);
begin  
  if depurando then
    writeln('Orden (AnalizaCO):',orden);
  if orden = 'CLS' then
    begin
    analizarCLS;
    end
  else
  if orden = 'DEC' then
    begin
    analizarDEC;
    end
  else  
  if orden = 'CPCINK' then
    begin
    analizarCPCINK;
    end
  else    
  if orden = 'CPCMODE' then
    begin
    analizarCPCMODE;
    end
  else
  if orden = 'FOR' then
    begin
    analizarFOR;
    end
  else
  if orden = 'GOTO' then
    begin
    analizarGOTO;
    end
  else
  if orden = 'GRAPHICSPEN' then
    begin
    analizarGRAPHICSPEN;
    end
  else
  if orden = 'INC' then
    begin
    analizarINC;
    end
  else
  if orden = 'IF' then
    begin
    analizarIF;
    end
  else  
  if orden = 'LINE' then
    begin
    analizarLINE;
    end
  else
  if orden = 'LOCATE' then
    begin
    analizarLOCATE;
    end
  else
  if orden = 'PAPER' then
    begin
    analizarPAPER;
    end
  else
  if orden = 'PEN' then
    begin
    analizarPEN;
    end
  else
  if orden  = 'PLOT' then
    begin
    analizarPLOT;
    end
  else    
  if orden = 'REPEAT' then
    begin
    analizarREPEAT;
    end
  else
  if orden = 'WHILE' then
    begin
    analizarWHILE;
    end
  else
  if orden = 'WRITECHAR' then
    begin
    analizarWRITECHAR;
    end
  else
  if orden = 'WRITESTRING' then
    begin
    analizarWRITESTRING;
    end
  else
  if orden = 'END' then
    begin
    leerSimbolo('.');
    finFicheroEntrada := true;
    end
  else
  if orden = 'BEGIN' then
    begin
    (* Begin: no hacer nada *)
    end
  else
  {if orden = ' ' then
    begin
    (* Espacio: no hacer nada -para esquivar un bug del lexer- *)
    end
  else
  if orden = '' then
    begin
    (* Orden vacia: no hacer nada *)
    end
  else}
    (* Si no es orden reconocida, es identificador:
     asignacion, etiqueta de salto
     o -mas adelante- llamada a procedure/function *)
    begin
    if leerSimboloTS(orden) = tINEXIST then
      errorFatal('Error: orden no reconocida '+orden);
    analizarLABELoASIGN(orden);  
    end;
end;


procedure analizarLABELoASIGN(variable: string);
var
  ident: string;
  siguiente: token;
begin
  siguiente := obtenerToken;
  if siguiente.tipo = tkPYC then (* nombre; = procedimiento *)
    begin
    genComentario('. Llamada a procedimiento: '+variable);
    GenLlamada;
    genDireccSinGOTO(variable);
    exit;
    end
  else if siguiente.tipo = tkASIGN then
    begin (* := - Asignacion *)
    ident := obtenerToken.valor;  
    leerSimbolo(';');
    genASIGN(variable,ident);
    end
  else if siguiente.tipo = tkDOSP then
    begin (* : - Etiqueta *)
    genLABEL(variable);
    end
  else
    errorFatal('Error de sintaxis: leido'+siguiente.valor+'.');
end;

procedure analizarCLS;
begin
  leerSimbolo(';');
  genCLS;
end;

procedure analizarCONST;
var
  ident: string;
  terminador: token;
begin
  ident := obtenerToken.valor;
  leerSimbolo('=');
  insertarSimboloConst(ident, obtenerToken.valor);
  terminador := obtenerToken;
  if (terminador.tipo <> tkPYC) and (terminador.tipo <> tkCOMA) then
    errorFatal('Terminador incorrecto');
  if terminador.tipo = tkCOMA then
    analizarConst;
end;

procedure analizarCPCINK;
var
  tinta: string;
  color1, color2: token;
  separador: string;
begin
  leerSimbolo('(');
  tinta := obtenerToken.valor;
  genLecturaValorByte(tinta);
  leerSimbolo(',');
  color1 := obtenerToken;
  separador := obtenerToken.valor;
  if separador = ')' then
      color2 := color1
    else 
      begin
      if separador <> ',' then
        errorFatal('Se esperaba una coma');
      color2 := obtenerToken;
      leerSimbolo(')');
      end;  
  leerSimbolo(';');
  genCPCINK(color1, color2);
end;

procedure analizarCPCMODE;
var
  t: token;
begin
  leerSimbolo('(');
  t := obtenerToken;
  if not validarByte(t) then errorFatal('Se esperaba un dato de tipo byte');  
  genLecturaValorByte(t.valor);
  leerSimbolo(')');
  leerSimbolo(';');
  genCPCMODE;
end;

procedure analizarDEC;
var
  ident: string;
  terminador, cifra: token;
  decremento, codError: integer;
begin
  leerSimbolo('(');
  ident := obtenerToken.valor;
  terminador := obtenerToken;
  if terminador.tipo = tkCOMA then
    begin
    cifra := obtenerToken;
    val(cifra.valor, decremento, codError);
    if codError <>0 then
      errorFatal('Decremento no numerico');
    leerSimbolo(')');
    end
  else if (terminador.tipo <> tkPARD) then
    errorFatal('Se esperaba ) o ,');  
  leerSimbolo(';');
  genDEC(ident, decremento);
end;


procedure analizarFOR;
var
  ident, valorIni, valorFin, ordenTo: string;
  tipoComparacion, terminador: char;
  ifactual: string;
begin
  (* Uso el numero de IF actual para generar 
     las etiquetas de salto. Lo copio en una variable
     local para evitar modificaciones inesperadas
     en IF anidados *)     
  str(numeroIFactual,ifactual);
  inc(numeroIFactual);
  insertarSimboloLabel('FOR_'+ifActual);
  insertarSimboloLabel('FIN_FOR_'+ifActual);
  (* Comienza el analisis en si *)
  ident := obtenerToken.valor;
  leerSimbolo(':=');
  valorIni := obtenerToken.valor;
  genASIGN(ident, valorIni);
  genLABEL('FOR_'+ifActual);

  ordenTo := obtenerToken.valor;
    if ordenTo <> 'TO' then errorFatal('FOR sin TO');
    
  valorFin := obtenerToken.valor;
  ordenTo := obtenerToken.valor;
    if ordenTo <> 'DO' then errorFatal('FOR sin DO');  
  genIF(ident, '<=', valorFin);
  genDireccSinGOTO('FIN_FOR_'+ifActual);
  (* Bloque de codigo tras FOR *)
  analizarOrdenSimpleComp;
  genINC(ident,1);
  genGOTO('FOR_'+ifActual);

  genLABEL('FIN_FOR_'+ifActual);
  {leerSimbolo(';');}
end;


procedure analizarGOTO;
var
  ident: string;
begin
  ident := obtenerToken.valor;
  leerSimbolo(';');
  genGOTO(ident);
end;

procedure analizarGRAPHICSPEN;
begin
  leerSimbolo('(');
  genLecturaValorByte(obtenerToken.valor);
  leerSimbolo(')');
  leerSimbolo(';');
  genGRAPHICSPEN;
end;


procedure analizarIF;
var
  ident1, ident2, ordenThen, ordenElse: string;
  tipoComparacion, terminador: token;
  ifactual: string;
  tokenFinal: token;
begin
  (* Uso el numero de IF actual para generar 
     las etiquetas de salto. Lo copio en una variable
     local para evitar modificaciones inesperadas
     en IF anidados *)
  str(numeroIFactual,ifactual);
  inc(numeroIFactual);
  insertarSimboloLabel('ELSE_'+ifActual);
  insertarSimboloLabel('FIN_IF_'+ifActual);
  (* Comienza el analisis en si *)
  ident1 := obtenerToken.valor;
  tipoComparacion := obtenerToken;
  ident2 := obtenerToken.valor;
  ordenThen := obtenerToken.valor;
  if ordenThen <> 'THEN' then errorFatal('IF sin THEN');
  genIF(ident1, tipoComparacion.valor, ident2);
  genDireccSinGOTO('ELSE_'+ifActual);
  (* Bloque de codigo tras IF-THEN *)
  analizarOrdenSimpleComp;
  genGOTO('FIN_IF_'+ifActual);
  genLABEL('ELSE_'+ifActual);
  tokenFinal := obtenerToken;
  orden := tokenFinal.valor;
  (* Si lo siguiente empieza por E, debe ser ELSE *)
  if orden = 'ELSE' then
    begin
    (*ordenElse := obtenerToken.valor;
    if ordenThen <> 'LSE' then errorFatal('Error de sintaxis en ELSE');*)
    if depurando then
      writeln('Else para el IF');
    analizarOrdenSimpleComp;
    {terminador := obtenerToken;}
    genLABEL('FIN_IF_'+ifActual);
    end
  else
    begin
    genLABEL('FIN_IF_'+ifActual);
    if depurando then
      writeln('Sin Else: devolviendo Token');
    {if orden <> ';' then
      errorFatal('Sin ; al final de IF');}
    devolverToken(tokenFinal);
    end;
  (* Si no, es ; o error *)
  {if terminador <> ';' then
    errorFatal('Sin ; al final de IF');}
  if depurando then
      writeln('Fin - IF');
end;


procedure analizarINC;
var
  ident: string;
  terminador, cifra: token;
  incremento, codError: integer;
begin
  leerSimbolo('(');
  ident := obtenerToken.valor;
  terminador := obtenerToken;
  if terminador.tipo = tkCOMA then
    begin
    cifra := obtenerToken;
    val(cifra.valor, incremento, codError);
    if codError <>0 then
      errorFatal('Incremento no numerico');
    leerSimbolo(')');
    end
  else if (terminador.tipo <> tkPARD) then
    errorFatal('Se esperaba ) o ,');  
  leerSimbolo(';');
  genINC(ident, incremento);
end;


procedure analizarLABEL;
var
  ident: string;
  terminador: token;
begin
  ident := obtenerToken.valor;
  insertarSimboloLabel(ident);
  terminador := obtenerToken;
  if (terminador.tipo <> tkPYC) and (terminador.tipo <> tkCOMA) then
    errorFatal('Terminador incorrecto');
  if terminador.tipo = tkCOMA then
    analizarLabel;
end;

procedure analizarLOCATE;
begin
  leerSimbolo('(');
  genLecturaValorByte(obtenerToken.valor);
  genLOCATE1;
  leerSimbolo(',');
  genLecturaValorByte(obtenerToken.valor);
  leerSimbolo(')');
  leerSimbolo(';');
  genLOCATE2;
end;


procedure analizarPAPER;
begin
  leerSimbolo('(');
  genLecturaValorByte(obtenerToken.valor);
  leerSimbolo(')');
  leerSimbolo(';');
  genPAPER;
end;

procedure analizarPEN;
begin
  leerSimbolo('(');
  genLecturaValorByte(obtenerToken.valor);
  leerSimbolo(')');
  leerSimbolo(';');
  genPEN;
end;

procedure analizarLINE;
var 
  x,y: string;
begin
  leerSimbolo('(');
  x := obtenerToken.valor;
  leerSimbolo(',');
  y := obtenerToken.valor;
  leerSimbolo(')');
  leerSimbolo(';');
  genLINE(x,y);
end;

procedure analizarPLOT;
var 
  x,y: string;
begin
  leerSimbolo('(');
  x := obtenerToken.valor;
  leerSimbolo(',');
  y := obtenerToken.valor;
  leerSimbolo(')');
  leerSimbolo(';');
  genPLOT(x,y);
end;

procedure analizarPROCEDURE;
var
  ident: string;
  direccionCadena: string;  
  orden: string;  
begin
  (* Primero el nombre del procedimiento *)
  ident := obtenerToken.valor;
  str(leerDireccionCodigoActual, direccionCadena);  
  insertarSimboloProcedure(ident, direccionCadena);
  leerSimbolo(';');
  genComentario('- Procedure ' + IDENT);
  
  orden := obtenerToken.valor;
  (* Luego un bloque BEGIN...END *)
  if orden <> 'BEGIN' then
    errorFatal('No hay BEGIN en el PROCEDURE')
  else
    repeat
      (* Debe terminar con END *)
      orden := obtenerToken.valor;
      if orden <> 'END' then
        analizarCualquierOrden(orden);        
    until orden = 'END';
  genRetorno;
  leerSimbolo(';');
end;


procedure analizarREPEAT;
var
  ident1, ident2, orden: string;
  tipoComparacion, terminador: token;
  ifactual: string;
begin
  (* Uso el numero de IF actual para generar 
     las etiquetas de salto. Lo copio en una variable
     local para evitar modificaciones inesperadas
     en IF anidados *)
  str(numeroIFactual,ifactual);
  inc(numeroIFactual);
  insertarSimboloLabel('REPEAT_'+ifActual);
  genLABEL('REPEAT_'+ifActual);
  (* Comienza el analisis en si *)
  repeat
    orden := obtenerToken.valor;
    if orden <> 'UNTIL' then
      analizarCualquierOrden(orden);
  until orden = 'UNTIL';
  ident1 := obtenerToken.valor;
  tipoComparacion := obtenerToken;
  ident2 := obtenerToken.valor;
  genREPEAT(ident1, tipoComparacion.valor, ident2);
  genDireccSinGOTO('REPEAT_'+ifActual);
  
  leerSimbolo(';');
end;

procedure analizarWHILE;
var
  ident1, ident2, ordenDo: string;
  tipoComparacion, terminador: token;
  ifactual: string;
begin
  (* Uso el numero de IF actual para generar 
     las etiquetas de salto. Lo copio en una variable
     local para evitar modificaciones inesperadas
     en IF anidados *)
  str(numeroIFactual,ifactual);
  inc(numeroIFactual);
  insertarSimboloLabel('WHILE_'+ifActual);
  genLABEL('WHILE_'+ifActual);
  insertarSimboloLabel('FIN_WHILE_'+ifActual);
  
  (* Comienza el analisis en si *)
  ident1 := obtenerToken.valor;
  tipoComparacion := obtenerToken;
  ident2 := obtenerToken.valor;
  ordenDo := obtenerToken.valor;
  if ordenDo <> 'DO' then errorFatal('WHILE sin DO');
  genWHILE(ident1, tipoComparacion.valor, ident2);
  genDireccSinGOTO('FIN_WHILE_'+ifActual);
  (* Bloque de codigo tras WHILE *)
  analizarOrdenSimpleComp;
  genGOTO('WHILE_'+ifActual);
  genLABEL('FIN_WHILE_'+ifActual);
  {leerSimbolo(';');}
end;


procedure analizarVAR;
var
  ident: string;
  tipoVar: string;
  separador, terminador: token;
begin
  ident := obtenerToken.valor;
  { Despues del identificador podra ir :tipo o ,var }
  { De momento, solo una variable }
  separador := obtenerToken;
  while separador.tipo = tkCOMA do (* Quedan variables *)
    begin
    insertarSimboloVar(ident, tSINTIPO);
    ident := obtenerToken.valor;
    separador := obtenerToken;
    end;
  if separador.tipo = tkDOSP then (* Fin de declaracion *)
    begin
    tipoVar := obtenerToken.valor;
    if (tipoVar = 'BYTE') then
      begin
      insertarSimboloVar(ident, tByte);
      indicarTiposVar(tByte);
      end
    else if (tipoVar = 'INTEGER') then
      begin
      insertarSimboloVar(ident, tInteger);
      indicarTiposVar(tInteger);
      end
    else errorFatal('Tipo incorrecto');
    terminador := obtenerToken;
    if (terminador.tipo <> tkPYC) then
      errorFatal('Terminador incorrecto');
    end;
end;


procedure analizarWRITECHAR;
var
  t: token;
  numero: string;
begin
  leerSimbolo('(');
  t := obtenerToken;
    if t.valor = '''' then 
      begin
      letra := obtenerLetra;
      leerSimbolo('''');
      str(ord(letra),numero);
      genLecturaValorByte( numero );
      end
    else
      begin
      genLecturaValorByte( t.valor );
      end;
  leerSimbolo(')');
  leerSimbolo(';');
  genWRITECHAR;
end;


procedure analizarWRITESTRING;
var
  texto: string;
begin
  leerSimbolo('(');
  leerSimbolo('''');
  texto := obtenerCadena;
  leerSimbolo('''');
  leerSimbolo(')');
  leerSimbolo(';');
  genWRITESTRING(texto);
end;


begin
end.
